home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 2: Applications / Linux Cubed Series 2 - Applications.iso / math / gle-3.000 / gle-3 / gle / sub.c < prev    next >
C/C++ Source or Header  |  1995-02-07  |  3KB  |  152 lines
  1. #include "all.h"
  2. int var_alloc_local(void);
  3. int var_free_local(void);
  4. extern int32 *(*gpcode)[];   /* gpcode is a pointer to an array of poiter to int32 */
  5. extern int32 (*gplen)[];   /* gpcode is a pointer to an array of int32 */
  6. extern int ngpcode;
  7. extern int gle_debug;
  8. #define dbg if ((gle_debug & 128)>0)
  9.  
  10. struct sub_st {char name[40];int typ; int np
  11.         ; int ptyp[20]; char *pname[20]; int start; int end ; }  ;
  12. struct sub_st *sb[100];
  13. int nsb;
  14. double return_value=0;
  15. char return_string[80];
  16. int return_type;
  17.  
  18.  
  19. sub_param(int idx,char *s)
  20. {
  21.     int vi,vt;
  22.     mystrcpy(&( sb[idx]->pname[ ++(sb[idx]->np) ] ) ,s);
  23.     /* should be set ptype according to num/string variable */
  24.     var_add(s,&vi,&vt);
  25.     sb[idx]->ptyp[ (sb[idx]->np) ] = vt;
  26. }
  27. sub_find(char *s,int *idx,int *zret, int *np, int **plist)
  28. {
  29.     int i;
  30.     *idx = 0;
  31.     for (i=1;i<=nsb;i++) {
  32.         if (strcmp(sb[i]->name,s)==0) {
  33.             *idx = i;
  34.             *zret = sb[i]->typ;
  35.             *np = sb[i]->np;
  36.             *plist = &(sb[i]->ptyp[1]);
  37.             return i;
  38.         }
  39.     }
  40.     return 0;
  41. }
  42. sub_clear()
  43. {
  44.     int i,j;
  45.     for (i=1;i<=nsb;i++) {
  46.       if (sb[i] != NULL) {
  47.         for (j=1; j<= sb[i]->np; j++) {
  48.             if (sb[i]->pname[j] != NULL) myfree(sb[i]->pname[j]);
  49.         }
  50.       }
  51.       myfree(sb[i]);
  52.       sb[i] = NULL;
  53.     }
  54.     nsb = 0;
  55. }
  56. int sub_def(char *s)
  57. {
  58.     int i;
  59.     for (i=1;i<=nsb;i++) {
  60.         if (strcmp(sb[i]->name,s)==0) {
  61.             strcpy(sb[i]->name,"^");
  62.         }
  63.     }
  64.     if (i>nsb) {
  65.         nsb = i;
  66.         sb[i] = myallocz(sizeof(*sb[0]));
  67.         strcpy(sb[i]->name,s);
  68.     }
  69.     sb[i]->np = 0;
  70.     return i;
  71. }
  72. sub_set_startend(int idx, int ss, int ee)
  73. {
  74.     if (idx<0 || idx>1000) {
  75.         gprint("idx is out of range \n");
  76.         return;
  77.     }
  78.     sb[idx]->start = ss;
  79.     sb[idx]->end = ee;
  80. }
  81. sub_get_startend(int idx, int *ss, int *ee)
  82. {
  83.     *ss = sb[idx]->start;
  84.     *ee = sb[idx]->end;
  85. }
  86.  
  87. /*--------------------------------------------------------------------------*/
  88. /*     Run a user defined function  */
  89. sub_call(int idx,double *pval,char **pstr,int *npm, int *otyp)
  90. {
  91.     int i;
  92.     int endp;
  93.     double save_return_value;
  94.  
  95.         save_return_value = return_value;
  96.     var_alloc_local();
  97.     dbg for (i=0;i<4;i++) gprint("STACK IN SUBCALL, (%d) = %f \n",i,*(pval+i));
  98.     if (*npm<sb[idx]->np) gprint("parameters in sub_call, not enough **\n");
  99.     for (i = sb[idx]->np;i>=1;i--) {
  100.         if (sb[idx]->ptyp[i] == 1)  {
  101.             var_set(200 + i-1,*(pval+(*npm)--));
  102.         } else    {
  103.             var_setstr(200 + i-1,*(pstr+(*npm)--));
  104.         }
  105.     }
  106.  
  107.     dbg gprint("SUB CALL ----- startline %d   end %d \n",
  108.         sb[idx]->start,sb[idx]->end);
  109.  
  110.     for (i = sb[idx]->start + 1;i< (sb[idx]->end);i++) {
  111.         dbg gprint("=Call do pcode, line %d ",i);
  112.         do_pcode(&i,(*gpcode)[i],(*gplen)[i],&endp);
  113.         dbg gprint("AFTER DO_PCODE I = %d \n",i);
  114.     }
  115.     dbg gprint("FINISHED CALL ------\n");
  116.     *(pval + ++(*npm)) = return_value;
  117.     return_value = save_return_value;
  118.     var_free_local();
  119.     dbg for (i=0;i<=*npm;i++) gprint("STACK IN SUBCALL, (%d) = %f \n",i,*(pval+i));
  120.     *otyp = sb[idx]->typ;
  121. }
  122. sub_set_return(double d)
  123. {
  124.     return_value = d;
  125. }
  126.  
  127.  
  128.  
  129.  
  130.  
  131.  
  132.  
  133.  
  134.  
  135.  
  136.  
  137.  
  138.  
  139.  
  140.  
  141.  
  142.  
  143.  
  144.  
  145.  
  146.  
  147.  
  148.  
  149.  
  150.  
  151.  
  152.